by Vova Sitsi (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 18th March 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
The VB script will look for *.URL files on the HDD`s, take the url paths and write them to HTML file
VBcoders
Set fso = CreateObject("Scripting.FileSystemObject")
Public newHtml,papka,content
papka=0
newHtml="<html>"&vbcrlf&"<head>"&vbcrlf&"<title>*.URL файлы в одном HTML-файле</title>"_
&vbcrlf&"<base target="&chr(34)&"_blank"&chr(34)&">"&vbcrlf&"</head>"_
&vbcrlf&"<body>"&vbcrlf&"<h2>*.URL файлы в одном HTML-файле</h2>"
content="<html>"&vbcrlf&"<head>"&vbcrlf&"<title>*.URL файлы в одном HTML-файле</title>"_
&vbcrlf&"<base target="&chr(34)&"main"&chr(34)&">"&vbcrlf&"</head>"_
&vbcrlf&"<body>"&vbcrlf&"<h3>Содержание:</h3>"
listadriv
Else
Msgbox "Otmena",,"Oblom"
End If
sub listadriv
'On Error Resume Next
Dim d,dc
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 or d.DriveType=3 Then
newHtml=newHtml&vbcrlf&"<UL STYLE="&chr(34)&"font-color:maroon;"&chr(34)&">На диске "&d
folderlist(d.path&"\")
newHtml=newHtml&vbcrlf&"</UL>"
end if
Next
set b=fso.CreateTextFile("C:\links.htm")
b.close
newHtml=newHtml&vbcrlf&"</html>"
set d=fso.OpenTextFile("C:\links.htm",2)
d.write newHtml
d.close
set co=fso.CreateTextFile("C:\content.htm")
co.close
content=content&vbcrlf&"</html>"
set cc=fso.OpenTextFile("C:\content.htm",2)
cc.write content
cc.close
set lo=fso.CreateTextFile("C:\mainlink.htm")
lo.close
set lo=fso.OpenTextFile("C:\mainlink.htm",2)
lo.write "<html>"&vbcrlf&"<head>"&vbcrlf&_
"<title>*.URL файлы в одном HTML-файле</title>"&vbcrlf&"</head>"&vbcrlf&_
"<frameset framespacing=1 border=1 cols="&chr(34)&"240,*"&chr(34)&">"&vbcrlf&_
"<frame name="&chr(34)&"contents"&chr(34)&" target="&chr(34)&"main"&chr(34)&" scrolling="&chr(34)&"auto"&chr(34)&" src="&chr(34)&"content.htm"&chr(34)&">"&vbcrlf&_
"<frame name="&chr(34)&"main"&chr(34)&" scrolling="&chr(34)&"auto"&chr(34)&" src="&chr(34)&"links.htm"&chr(34)&" target="&chr(34)&"_blank"&chr(34)&">"&vbcrlf&_
"</frameset>"&vbcrlf&"</html>"
lo.close
msgbox "Gotovo! Otkrivai fail c:\mainlink.htm"
end sub
sub smotrim(folderspec)
'On Error Resume Next
dim d,s4it,f,f1,fc,ext,ap,mircfname,s,bname,urlLin
set f = fso.GetFolder(folderspec)
set fc = f.Files
for each f1 in fc
ext=fso.GetExtensionName(f1.path)
ext=lcase(ext)
s=lcase(f1.name)
bname=fso.GetBaseName(f1.path)
if (ext="url") then
set d=fso.OpenTextFile(folderspec&"\"&s,1)
for s4it=1 to 20
urlLin=d.ReadLine
if lcase(left(urlLin,3))="url" then
if papka=0 then
newHtml=newHtml&vbcrlf&"<a name="&chr(34)&f&chr(34)&">"&vbcrlf&"<ul>В дире <b>"&f&"</b>"
content=content&vbcrlf&"<a href="&chr(34)&"links.htm#"&f&chr(34)&">"&f&"</a><br>"
papka=1
end if
newHtml=newHtml&vbcrlf&"<li><a href="&chr(34)&mid(urlLin,5)&chr(34)&">"&bname&"</a>"
exit for
end if
next
d.close
end if
next
end sub
sub folderlist(folderspec)
On Error Resume Next
dim f,f1,sf
set f = fso.GetFolder(folderspec)
set sf = f.SubFolders
for each f1 in sf
if papka<>0 then
newHtml=newHtml&vbcrlf&"</ul>"
papka=0
end if
smotrim(f1.path)
folderlist(f1.path)
next
end sub
No comments have been posted about The VB script will look for *.URL files on the HDD`s, take the url paths and write them to HTML fil. Why not be the first to post a comment about The VB script will look for *.URL files on the HDD`s, take the url paths and write them to HTML fil.